perm filename DPY.F4[PIC,LCS] blob
sn#525280 filedate 1982-01-09 generic text, type T, neo UTF8
SUBROUTINE DPY
COMMON/D/ JD(4000),I(3,40000)
COMMON NAME
2 FORMAT(4I)
4 FORMAT(' 0=SEE NEXT DPY UNIT; 99=EXIT; OR X-Y SHIFT. '$)
JJ=0
KK=0
CC MM=1
CC NN=1
C6 CALL IFILE(22,NAME)
6 N=0
50 KNT=0
TYPE 2,(I(NX,N+1),NX=1,3)
C TYPE 1ST X-Y COORDS.
CALL DPYSET(1,JD,4000)
CALL DPYCLR
C1 READ(22,2,END=99)N,(I(K,N),K=1,3)
1 N=N+1
NZ=I(3,N)
IF(NZ.GT.1)GO TO 1
IF(NZ)GO TO 99
C -1 IN 3RD SLOT=END
NX=JJ+I(1,N)
NY=KK+I(2,N)
KNT=KNT+1
IF(KNT.GT.3900)GO TO 99
IF(NZ.NE.0)GO TO 3
7 CALL AVECT(NX,NY)
GO TO 1
3 CALL AIVECT(NX,NY)
GO TO 1
99 CALL DPYOUT(1)
TYPE 4
ACCEPT 2,JJ,KK
IF(JJ.EQ.0)GO TO 50
IF(JJ.EQ.99)RETURN
GO TO 6
END
SUBROUTINE NNO(NN)
IF(NN.LT.39999)GO TO 2
TYPE 1
1 FORMAT(' TOO MANY POINTS')
RETURN
2 NN=NN+1
END
SUBROUTINE SHFT(II,JIN,NX)
COMMON NMOUT/OUTER/LFT,RT,TOP,BOT
INTEGER LFT,RT,TOP,BOT
COMMON /JJJJ/JP,KP,XS,YS
DIMENSION II(4),JIN(3,1000)
NX=NX+1
II(1)=NX
K=JP+(JIN(1,NX)*XS+.5)
IF(K.GT.RT)RT=K
IF(K.LT.LFT)LFT=K
II(2)=K
K=KP+(JIN(2,NX)*YS+.5)
IF(K.GT.TOP)TOP=K
IF(K.LT.BOT)BOT=K
II(3)=K
II(4)=JIN(3,NX)
END